perm filename DRAWSM.OLD[DRW,LCS] blob sn#396829 filedate 1978-11-17 generic text, type T, neo UTF8
	SUBROUTINE DRAWIT
	COMMON/ED/K,NEXT,NN,NX,NY,J
	COMMON /RZ/RSZ,IPLT,RJB,CENTR
	COMMON /RC/MCLEF(400),IST(4000)
	COMMON/ZN/SCLEF(400,2),DDD
	COMMON/LL/LL
	COMMON/JJJ/JJJ
	DIMENSION ITEM(20)
	EQUIVALENCE(MM,SCLEF(1,1)),(W,IST(4000))
	DATA RN/15./
CC	CALL ACCPOG(1)
C  DISPLAYS OLD ITEM WITHOUT FILLER
CC	CALL DPYOUT(1)
	REL=-1
	JC=0
	KE=-1
	JCL=0
	RJ=1
	IF(MM.EQ.0)GO TO 20
	J=MM
	JX=-1
	JCL=MM
	NX=SCLEF(MM,1)
	NY=SCLEF(MM,2)
	GO TO 120
CC20	IF(JF.EQ.0)J=1
20	J=1
	JZ=J
2	NX=RJB*RSZ
	NY=CENTR*RSZ
121	JX=0
120	NZ=-1
	JC=1
	RL=NX
	RM=NY
C  L AND M ARE USED AS CONSTANTS WHEN RESETTING CURSOR
44	CALL SETCUR(NX,NY,0)
83	S=0
4	IF(S)GO TO 81
CJ  NO MORE LIGHT PEN SELECTION.	IF(K.EQ.'E')GO TO 700
	IF(K.EQ.'E')GO TO 79
C  BYPASS FOR EDITING.
45	FORMAT(' <CR> SETS POINT ',$)
	TYPE 45
	ACCEPT 144,K,ZK,KK
	IF(ZK.NE.'E')GO TO 344
	REL=0
C  TYPE REL FOR RELATIVE VECTORS, O=ORDINARY
	GO TO 4
344	IF(K.NE.'O')GO TO 244
	REL=-1
	GO TO 4
144	FORMAT(3A1)
244	IF(ZK.NE.'M')GO TO 444
C  TYPE SM TO SMOOTH, SMX=ERASE STRAIGHT LINES TEMPORARILY.
	MCLEF(1)=J
	CALL SMOOTH(KK)
	GO TO 4
444	IF(ZK.NE.'X')GO TO 445
	MCLEF(2)=MCLEF(2)+200000000
	K='X'
	GO TO 3
445	REREAD 1,K,ZK,XK
	IF(K.LE.' ')GO TO 40
	REREAD 11,RJ,RK,XK
	JMPR=0
	IF(XK.EQ.1)K='J'
C  TYPE 3RD NUM=1 FOR JUMPS
	IF(XK.EQ.2)K='F'
C  IF 3RD NUM=2 -- BEGIN FILL SECTION
41	QJ=RJ
	QK=RK
	IF(REL)GO TO 141
241	X=X+QJ*RSZ
	Y=Y+QK*RSZ
	NX=X
	NY=Y
	GO TO 48
141	NX=GTPT(RJ,RJB)
	NY=GTPT(RK,CENTR)
	X=NX
	Y=NY
	GO TO 481
40	KK=ZK
C B=BACKUP, J=JUMP, CR=SET POINT, X=EXIT, LRUD-N
C  F=FILL IT, H=GO TO HOME-NUM, N=GO TO NEXT(AFTER AN 'H')
C  Z=ZERO IN ON NEARBY POINT, P=GO TO PREVIOUS, C=CLOSE THE AREA
C  D=EXTEND DRAWING,  F=START FILLER OUTLINE, SM=SMOOTH IT
C  TYPE 'FX' TO FILL ORIGINAL OUTLINE AND EXIT.
C  L,R,U,D + NUM  MOVES LAST POINT ENTERED.
	IF(ZK.NE.0)NZ=-1
C  WILL STAY IN "Z" MODE UNLESS NUMBER APPEARS.
	JMPR=0
	JCX=2
C  JCX IS FOR "ZEROING-IN" SECTION AND EDIT SECTION
C  FOR SHIFTS OF "JUMPS"
	IF(K.EQ.'B')GO TO 22
CC	IF(K.EQ.'P')GO TO 56
	IF(K.EQ.'C')GO TO 51
	IF(K.EQ.'X')GO TO 3
	IF(K.EQ.' ')GO TO 47
	IF(K.EQ.'J')GO TO 47
	IF(K.EQ.'Z')GO TO 47
	IF(K.EQ.'S')GO TO 79
	IF(K.EQ.'F')GO TO 47
CC555	IF(K.NE.'N')GO TO 7
C****** NO MORE 'N' OR 'P' ******
	IF(K.NE.'H')GO TO 7
CC55	KK=NEXT
CC	GO TO 52
CC56	KK=NEXT-2
52	IF(KK.LE.1)KK=2
	X=SCLEF(KK,1)
	Y=SCLEF(KK,2)
	NEXT=KK+1
	IF(KE)GO TO 48
	RX=X
	RY=Y
58	IF(NEXT.GT.J+1)GO TO 44
	NN=JA-1
	CALL ITYP
	CALL EDTYP(K,X,Y,JJJ)
C  TYPE "A" OR ":" TO ALTER
C  TYPE "G"=GROUP CHANGE) TO MAKE RELATIVE CHANGE STICK
C  , THEN <CR>S. ANY OTHER LETTER TO ESCAPE
	IF(K.NE.'J')GO TO 573
C  J=JUMP TO NEXT 'JUMP'
	DO 574 K=NEXT,J
574	IF(MCLEF(K).GE.100000000)GO TO 575
575	X=K-NEXT+1
	GO TO 82
573  	IF(K.LT.'-')GO TO 1573
C  NEXT FOR NUMBERS ONLY -- FOR STEP AHEAD AND BACK
2573	REREAD 11,X
	GO TO 82
1573	IF(K.NE.'B')GO TO 570
	X=-X
	GO TO 82
570	IF(K.NE.' ')GO TO 1570
	IF(S)GO TO 81
1570	IF(K.EQ.'S')GO TO 82
C  S=STEP AHEAD(N) (-N  OR B GOES BACK)
	IF(K.EQ.'X')GO TO 3
	IF(K.NE.'M'.AND.K.NE.'R')GO TO 572
C  M OR R ALONE WILL MOVE LAST SET OF POINTS MOVED.  BUT BE CAREFUL!
	LL=0
	IF(X+Y.EQ.0)GO TO 580
	IF(X.OR.Y.EQ.0)GO TO 577
C  "M  -N1, N2, N3" MOVES WHOLE BLOCKS (OR "M N1 0")
C   OR USE 'R' FOR 'M' TO ROTATE GROUP OF POINTS
C  TO SET ITEM # N2≠0,  SETS ITEM # TO N3 IF N3≠0.
	NY=Y-X+2
	NX=X+1
576	MX=NX
	MY=NY
CC	IF(K.EQ.'R')MY=-MY
CC580	NY=MY
580	CALL SHIFT(MCLEF(MX),MY,K)
C  TO MOVE SEGS MX THROUGH MY.
	CALL CLRPOG(1)
	CALL POG1
	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL DPYOUT(1)
	GO TO 58

577	NX=ABS(X)
	IF(Y.NE.0)GO TO 578
	CALL UNPACK(NX,NX,NY,ITEM)
	GO TO 576
578	NY=ABS(Y)
	IF(JJJ.NE.0)GO TO 579
	IK=IK+1
	TYPE 46,IK
	JJJ=IK
	IF(JJJ.GT.10)GO TO 58
CC579	JB=NX
579	LL=0
	NY=NY-NX+2
	NX=NX+1
	JB=NX
	CALL REPACK(JJJ,JB,NY,ITEM)
	GO TO 576

572	MCLEF(1)=J
	IF(K.EQ.'F')GO TO 470
C  TAKE OUT OTHER 'F'S IN DREDIT*****
571	CALL DREDIT
59	X=RX
	Y=RY
	KE=-1
	NX=0
	NY=0
	GO TO 170
C  THIS WRECKS "CLOSE"
470	MCLEF(NEXT-1)=MCLEF(NEXT-1)+200000000
	K='X'
	GO TO 34
47	IF(REL.EQ.0)GO TO 22
C  IF IN "REL" MODE TYPE "O" BEFORE USING LTPEN
	CALL RDCUR(NX,NY)
	X=NX
	Y=NY
	IF((K.NE.'Z'.AND.NZ).OR.K.EQ.'J'.OR.K.EQ.'F')GO TO 48
	NZ=0
	DO 54 K=JCX,JCL
      IF(ABS(SCLEF(K,1)-X).GT.RN.OR.ABS(SCLEF(K,2)-Y).GT.RN)
	1 GO TO 54
	KK=K
	GO TO 52
54	CONTINUE
	IF(KE)GO TO 48
C  KE=-1  = DRAW MODE (NOT EDIT)
	TYPE 154
	GO TO 4
154	FORMAT(' NO POINT FOUND ')
C  ABOVE FOR INITIAL MOVEMENT OF CURSOR
51	X=RX
	Y=RY
48	RJ=STPT(X,RJB)
	RK=STPT(Y,CENTR)
481	SK=RK
	J=J+1
551	SJ=RJ
C  DO I NEED RJ,RK ANYWHERE??  YES - AT REPACK
451	LL=0
	IF(K.EQ.'J')LL=100000000
C  J=JUMP
	IF(K.NE.'F')GO TO 452
	K='J'
253	LL=200000000
452	IJ=RJ
	IK=RK
	JCL=J
	CALL REPACK(J,IJ,IK,MCLEF)
	IF(MCLEF(J).NE.MCLEF(J-1).OR.J.EQ.2)GO TO 60
61	J=J-1
	GO TO 4
60	SCLEF(J,1)=X
	SCLEF(J,2)=Y
50	N=IST(2)
	X=GTPT(SJ,RJB)
	Y=GTPT(SK,CENTR)
	NX=X
	NY=Y
	IF(K.EQ.'B')GO TO 5
	IF(K.EQ.'J'.OR.JMPR.OR.JX.EQ.0)GO TO 6
	CALL AVECT(NX,NY)
	GO TO 5
6	CALL AIVECT(NX,NY)
	JX=-1
	JMPR=-1
C  KZ IS FOR "CLOSE IT"
	NZ=-1
	RX=X
	RY=Y
5	CALL DPYOUT(1)
	L=J-1
	TYPE 46,L,SJ,SK

170	CALL SETCUR(NX,NY,JC)
	GO TO 4
74	FORMAT(' S(TEP) OR L(IGHT PEN)? ',$)
7	IF(K.NE.'E')GO TO 71
C  E=EDIT 
CC700	TYPE 74
CC	ACCEPT 1,K,X
CC	IF(K.NE.'L')GO TO 79
CC	IF(ZK.NE.0)JCX=ZK
C  SETS "ZEROING-IN" FIRST COUNTER
CC	NZ=0

CC	KE=0
C  EDIT FLAG  KE=0
CC	TYPE 70
CC	GO TO 44
CC70	FORMAT(' CHOOSE A POINT ')
71	IF(ZK.EQ.0)ZK=1
	IF(K.EQ.'L'.OR.K.EQ.'D')ZK=-ZK
	IF(K.EQ.'L'.OR.K.EQ.'R')GO TO 77
	SK=ZK+SK
	Y=GTPT(SK,CENTR)
	GO TO 78
77	SJ=ZK+SJ
	X=GTPT(SJ,RJB)
78	CALL BUP
	J=J-1
	GO TO 48
79	S=-1
	JA=ZK-1
84	IF(JA.LT.2)JA=1
81	IF(K.NE.'D')JA=JA+1
	IF(JA.GT.J)JA=J
	X=SCLEF(JA,1)
	Y=SCLEF(JA,2)
	NX=X
	NY=Y
	NEXT=JA+1
	CALL SETCUR(NX,NY,0)
	GO TO 58
82	IF(X.EQ.0)X=-1
	JA=JA-1+X
	GO TO 84
22	IF(J.EQ.JZ)GO TO 4
C  CAN'T BACKUP PAST 1 OR 'F'
	J=J-1
122	CALL UNPACK(J,IJ,IK,MCLEF)
	CALL BUP
	SJ=IJ
	SK=IK
	IF(K.EQ.'B')GO TO 50
	RJ=RJ+QJ
	RK=RK+QK
	GO TO 241
3	MCLEF(1)=J
	IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
34	CALL CLRCUR
	IF(K.NE.'X')GO TO 120
1	FORMAT(A1,2F)
11	FORMAT(3F)
46	FORMAT(I3,'.)',2F6.0/)
	END